home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / minihelp.001 / minihelp~ / MiniHelp.tcl < prev   
Encoding:
Text File  |  1996-03-29  |  57.7 KB  |  1,752 lines
  1. ###############################################################
  2. # Minihelp - Help Editor
  3. # Charlie KEMPSON - charlie@siren.demon.co.uk
  4. # http://public.logica.com/~kempsonc
  5. ###############################################################
  6.  
  7. ###############################################################
  8. #    This program is free software; you can redistribute it 
  9. #    and/or modify it under the terms of the GNU General 
  10. #    Public License as published by the Free Software 
  11. #    Foundation (version 2 of the License).
  12. #
  13. #    This program is distributed in the hope that it will 
  14. #    be useful, but WITHOUT ANY WARRANTY; without even the 
  15. #    implied warranty of MERCHANTABILITY or FITNESS FOR A 
  16. #    PARTICULAR PURPOSE.  See the GNU General Public License 
  17. #    for more details.
  18. #
  19. #    For a copy of the GNU General Public License, write to the 
  20. #    Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
  21. #    MA 02139, USA.
  22. ###############################################################
  23.  
  24. ###############################################################
  25. # Set include path
  26. set GLOBAL_INCLUDE "/usr/local/lib/TkNet"
  27. #set GLOBAL_INCLUDE "/home/charlie/TKNET/usr/local/lib/TkNet"
  28.  
  29. ###############################################################
  30. # Globals for this module
  31. set BITMAP_HEIGHT       60
  32. set BITMAP_WIDTH        40
  33.  
  34. # Globals
  35. set g_selected_file ""
  36. set g_selected_file_filter ""
  37.  
  38. # Flags
  39. set gas_pages ""
  40. set gas_history ""
  41. set gb_current_page_changed 0
  42. set gb_project_changed      0
  43. set gs_current_project      ""
  44. set gs_new_project_name     ""
  45. set gs_MH_NewHelpPage        ""
  46. set gs_cut_buffer           ""
  47. set gb_show_formatted       1
  48. set gb_keep_old_text        0
  49. set gb_page_autocommit      1
  50.  
  51. # Geometry
  52. set TKNET_HELP_GEOMETRY "+200+200"
  53. set FIXED_FONT_SMALL   -*-courier-medium-r-*-*-*-*-*-*-*-*-*-*
  54. set FIXED_FONT          -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
  55. set FONT_SMALL          -adobe-helvetica-medium-r-*-*-*-*-*-*-*-*-*-*
  56. set FONT_NORMAL         -adobe-helvetica-medium-r-*-*-14-*-*-*-*-*-*-*
  57. set FONT_ITALIC         -adobe-helvetica-medium-o-*-*-14-*-*-*-*-*-*-*
  58. set FONT_BOLD           -adobe-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*
  59. set BUTTON_COLOUR       Grey65
  60. set TEXT_COLOUR         White
  61. set DEFAULT_COLOUR      Grey75
  62. set RED                 Red
  63. set GREEN               ForestGreen
  64. set LOWER_BORDER        3
  65. set RIDGE_BORDER        2
  66. set DEFAULT_PADDING     5
  67.  
  68. # Set Tk/tcl global variables
  69. set tk_strictMotif      1
  70. set tcl_precision       3
  71.  
  72. ###############################################################
  73. # Set application defaults
  74.  
  75. # Fonts
  76. option add *font $FONT_NORMAL startupFile
  77.  
  78. # Highlight
  79. option add *highlightThickness 0
  80.  
  81. # Colours
  82. option add *background  $DEFAULT_COLOUR startupFile
  83. option add *Text.background  $TEXT_COLOUR startupFile
  84. option add *Entry.background  $TEXT_COLOUR startupFile
  85.  
  86. ###############################################################
  87. # The procedure to read other tcl files stored in
  88. # /usr/local/lib/TkNet/modules
  89. proc MH_SourceOther { filename } {
  90.  
  91.    # Globals
  92.    global GLOBAL_INCLUDE
  93.  
  94.    # Look in the global area for files
  95.    if [file exists "$GLOBAL_INCLUDE/modules/$filename"] {
  96.       if [catch {uplevel #0 source "$GLOBAL_INCLUDE/modules/$filename"}] {
  97.          MH_InfoDialog . "Error reading file : this doesn't look like a Tcl archive"
  98.       }
  99.    } else {
  100.       # FILE MISSING FROM /usr/local/lib/TkNet/modules
  101.       MH_InfoDialog . "File $filename missing from $GLOBAL_INCLUDE/modules."
  102.    }
  103. }
  104.  
  105. ###############################################################
  106. # Display a blocking information dialog
  107. proc MH_InfoDialog { parent string } {
  108.  
  109.    # Globals
  110.    global FONT_NORMAL RIDGE_BORDER DEFAULT_PADDING \
  111.       BITMAP_HEIGHT BITMAP_WIDTH
  112.  
  113.    # Display the string to the user
  114.    if [winfo exists .dialog] return
  115.    toplevel .dialog
  116.    wm title .dialog [wm title $parent]
  117.    wm transient .dialog .
  118. #   wm resizable .dialog 0 0 
  119.    grab current .dialog
  120.  
  121.    ###############################################################
  122.    # Create the message
  123.    frame .dialog.fr -borderwidth $RIDGE_BORDER -relief groove
  124.    pack .dialog.fr -padx $DEFAULT_PADDING -pady \
  125.       $DEFAULT_PADDING -side top -expand true -fill both
  126.    label .dialog.fr.bitmap -bitmap info -height \
  127.       $BITMAP_HEIGHT -width $BITMAP_WIDTH
  128.    label .dialog.fr.message -text $string -justify left
  129.    pack .dialog.fr.bitmap .dialog.fr.message -side left \
  130.       -anchor w
  131.  
  132.    ###############################################################
  133.    # Create the buttons below the frame
  134.    frame .dialog.button_frame -borderwidth $DEFAULT_PADDING
  135.    pack .dialog.button_frame -side bottom -fill x
  136.    button .dialog.button_frame.dismiss \
  137.        -text Dismiss -command { destroy .dialog }
  138.    pack .dialog.button_frame.dismiss
  139.  
  140.    
  141.    ###############################################################
  142.    # Bind return and space to dismiss
  143.    bind .dialog <Return> {destroy .dialog}
  144.    bind .dialog <space> {destroy .dialog}
  145.  
  146.    ###############################################################
  147.    # Centre the dialog on the parent (was widget $parent)
  148.    MH_CentreDialog .dialog
  149.  
  150.    ###############################################################
  151.    # Wait for the button to be pressed
  152.    tkwait window .dialog
  153. }
  154.  
  155. ###############################################################
  156. # Display a blocking question dialog
  157. proc MH_QuestionDialog { parent string button1 button2 } {
  158.  
  159.    # Globals
  160.    global FONT_NORMAL RIDGE_BORDER DEFAULT_PADDING \
  161.       BITMAP_HEIGHT BITMAP_WIDTH g_status
  162.  
  163.    # Initialise return status
  164.    set g_status -1
  165.  
  166.    # Display the string to the user
  167.    if [winfo exists .dialog] {return $g_status}
  168.    toplevel .dialog
  169.    wm title .dialog [wm title $parent]
  170.    wm transient .dialog .
  171. #   wm resizable .dialog 0 0 
  172.    grab current .dialog
  173.  
  174.    ###############################################################
  175.    # Create the message
  176.    frame .dialog.fr -borderwidth $RIDGE_BORDER -relief groove
  177.    pack .dialog.fr -padx $DEFAULT_PADDING -pady \
  178.       $DEFAULT_PADDING -side top -expand true -fill both
  179.    label .dialog.fr.bitmap -bitmap questhead -height \
  180.       $BITMAP_HEIGHT -width $BITMAP_WIDTH
  181.    label .dialog.fr.message -text $string -justify left
  182.    pack .dialog.fr.bitmap .dialog.fr.message -side left \
  183.       -anchor w
  184.  
  185.    ###############################################################
  186.    # Create the buttons below the frame
  187.    frame .dialog.button_frame -borderwidth $DEFAULT_PADDING
  188.    pack .dialog.button_frame -side bottom -fill x
  189.    button .dialog.button_frame.ok \
  190.       -text $button1 -command {destroy .dialog; set g_status 0}
  191.    button .dialog.button_frame.cancel \
  192.       -text $button2 -command {destroy .dialog; set g_status 1}
  193.    pack .dialog.button_frame.ok .dialog.button_frame.cancel \
  194.       -side right
  195.  
  196.    ###############################################################
  197.    # Centre the dialog on the parent
  198.    MH_CentreDialog .dialog
  199.  
  200.    ###############################################################
  201.    # Wait for the button to be pressed
  202.    tkwait variable g_status
  203.    return $g_status
  204. }
  205.  
  206. ###############################################################
  207. # Display a blocking information dialog
  208. proc MH_WorkingDialog { parent string } {
  209.  
  210.    # Globals
  211.    global FONT_NORMAL RIDGE_BORDER DEFAULT_PADDING \
  212.       BITMAP_HEIGHT BITMAP_WIDTH
  213.  
  214.    # Display the string to the user
  215.    if [winfo exists .MH_WorkingDialog] return
  216.    set window [toplevel .MH_WorkingDialog]
  217.    wm title .dialog [wm title $parent]
  218.    wm transient $window .
  219. #   wm resizable $window 0 0 
  220.    grab current $window
  221.  
  222.    ###############################################################
  223.    # Create the message
  224.    frame $window.fr -borderwidth $RIDGE_BORDER -relief groove
  225.    pack $window.fr -padx $DEFAULT_PADDING -pady \
  226.       $DEFAULT_PADDING -side top -expand true -fill both
  227.    label $window.fr.bitmap -bitmap hourglass -height \
  228.       $BITMAP_HEIGHT -width $BITMAP_WIDTH
  229.    label $window.fr.message -text $string -justify left
  230.    pack $window.fr.bitmap $window.fr.message -side left \
  231.       -anchor w
  232.  
  233.    ###############################################################
  234.    # Centre the dialog on the parent (was widget $parent)
  235.    MH_CentreDialog $window
  236.    update
  237. }
  238.  
  239. ###############################################################
  240. # Centre a window on the screen (or parent)
  241. proc MH_CentreDialog {window {position ""} {parent ""}} {
  242.  
  243.    # Withdraw dialog and update all windows
  244.    wm withdraw $window
  245.    update idletasks
  246.    set win_width [winfo reqwidth $window]
  247.    set win_height [winfo reqheight $window]
  248.  
  249.    # Read the positioning argument (pointer, widget, default)
  250.    switch -glob -- $position {
  251.       p* {
  252.          # place at POINTER (centered is $a == center)
  253.          wm geometry $window +[expr \
  254.             [winfo pointerx $window]-$win_width \
  255.             /2]+[expr [winfo pointery $window]-\
  256.             $win_height/2]
  257.       }
  258.       w* {
  259.          # center about WIDGET $parent
  260.          wm geometry $window +[expr [winfo rootx $parent]+ \
  261.             ([winfo width $parent]-$win_width)/2]+[expr \
  262.             [winfo rooty $parent]+([winfo height \
  263.             $parent]-$win_height)/2]
  264.       }
  265.       default {
  266.          wm geometry $window +[expr ([winfo screenwidth \
  267.             $window]-$win_width) / 2]+[expr ([winfo screenheight \
  268.             $window]- $win_height) / 2]
  269.       }
  270.    }
  271.  
  272.    # Now show the window
  273.    wm deiconify $window
  274. }
  275.  
  276. ###############################################################
  277. # Create a scrolled text widget
  278. proc MH_ScrolledText { f width height horiz } {
  279.  
  280.    # Global 
  281.    global FIXED_FONT_SMALL
  282.  
  283.    frame $f
  284.    # The setgrid setting allows the window to be resized.
  285.    text $f.text -width $width -height $height \
  286.       -setgrid true  -width $width -wrap word \
  287.       -yscrollcommand [list $f.yscroll set] \
  288.       -font $FIXED_FONT_SMALL
  289.    if {$horiz == 1} {
  290.       $f.text configure -xscrollcommand [list \
  291.          $f.xscroll set] -wrap none 
  292.       scrollbar $f.xscroll -orient horizontal \
  293.          -command [list $f.text xview]
  294.       pack $f.xscroll -side bottom -fill x
  295.    }
  296.    scrollbar $f.yscroll -orient vertical \
  297.       -command [list $f.text yview]
  298.    pack $f.yscroll -side right -fill y
  299.  
  300.    # The fill and expand are needed when resizing.
  301.    pack $f.text -side left -fill both -expand true
  302.    pack $f -side top -fill both -expand true
  303.    return $f.text
  304. }
  305.  
  306. ###############################################################
  307. # Create a scrolled text widget
  308. proc MH_ScrolledList { frame width height mode horiz } {
  309.  
  310.    frame $frame
  311.    # The setgrid setting allows the window to be resized.
  312.    listbox $frame.list -width $width -height $height \
  313.       -setgrid true -yscrollcommand [list $frame.yscroll set] \
  314.       -selectmode $mode
  315.    if {$horiz == 1} {
  316.       $frame.list configure -xscrollcommand [list \
  317.          $frame.xscroll set] -wrap none 
  318.       scrollbar $frame.xscroll -orient horizontal \
  319.          -command [list $frame.list xview]
  320.       pack $frame.xscroll -side bottom -fill x
  321.    }
  322.    scrollbar $frame.yscroll -orient vertical \
  323.       -command [list $frame.list yview]
  324.    pack $frame.yscroll -side right -fill y
  325.  
  326.    # The fill and expand are needed when resizing.
  327.    pack $frame.list -side left -fill both -expand true
  328.    pack $frame -side top -fill both -expand true
  329.    return $frame.list
  330. }
  331.  
  332. ###############################################################
  333. # The procedure for popping up a popup menu
  334. proc MH_PopupMenu { parent window } {
  335.  
  336.    # Get current mouse position
  337.    set x [ winfo pointerx $parent ]
  338.    set y [ winfo pointery $parent ]
  339.  
  340.    # Popup the menu
  341.    tk_popup $window $x $y
  342. }
  343.  
  344. ###############################################################
  345. # Change cursor to an hourglass and back again
  346. proc MH_WatchCursor {} {
  347.  
  348.    # Loop through children setting the cursor
  349.         foreach w [winfo children .] {
  350.                 lappend busy [list $w [lindex [$w config -cursor] 4]]
  351.         }
  352.         foreach w $busy {catch {[lindex $w 0] config -cursor watch}}
  353.         update idletasks
  354. }
  355. proc MH_NormalCursor {} {
  356.  
  357.    # Loop through children setting the cursor
  358.         foreach w [winfo children .] {
  359.                 lappend notbusy [list $w [lindex [$w config -cursor] 4]]
  360.         }
  361.         foreach w $notbusy {catch {[lindex $w 0] config -cursor hand2}}
  362.         update idletasks
  363. }
  364.  
  365.  
  366. ###############################################################
  367. # The procedure for creating images
  368. proc MH_CreateImage { file } {
  369.  
  370.    # This procedure attempts to create an image from
  371.    # the data specified in the named file.  If the 
  372.    # file is non-existant, or the image type is not
  373.    # supported, -1 is returned and a dialogue is
  374.    # displayed.
  375.  
  376.    if [file exists $file] {
  377.  
  378.       # Create the image
  379.       set name [join [list $file "_image"] ""]
  380.       if [catch {image create bitmap $name -file $file} text] {
  381.          # Not a bitmap, try pixmap
  382.          if [catch {image create pixmap $name -file $file} text] {
  383.             # Not a pixmap, try gif
  384.             if [catch {image create photo $name -file $file} text] {
  385.                # Give up!
  386.                MH_InfoDialog . "Image $file has an unrecognised type!
  387. See help on images for more information."
  388.                return -1
  389.             }
  390.          }
  391.       }
  392.       return $name
  393.    } else {
  394.       MH_InfoDialog . "File $file does not exists!"
  395.       return -1
  396.    }
  397. }
  398.  
  399. ###############################################################
  400. # The procedure for selecting a file
  401. proc MH_FileSelect { {title "Select File"} {filter "*"} } {
  402.  
  403.    # This procedure pops up a file selection box
  404.    # and returns the selected file.
  405.  
  406.    # Globals
  407.    global TEXT_COLOUR DEFAULT_PADDING RIDGE_BORDER \
  408.       g_selected_file g_selected_file_filter
  409.    set g_selected_file_filter $filter
  410.    
  411.    # Popup a selection window
  412.    set window .fileselect
  413.    if [winfo exists $window] {
  414.        # Pop it up!
  415.        wm deiconify $window
  416.        raise $window
  417.        return
  418.    }
  419.  
  420.    # Otherwise create the window
  421.    toplevel $window
  422.    wm title $window $title
  423.    wm transient $window .
  424.  
  425.    # Create a frame containing the filter
  426.    frame $window.filter_fr -borderwidth $RIDGE_BORDER -relief groove
  427.    pack $window.filter_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  428.       -side top -fill x
  429.    label $window.filter_fr.label -text "Filter"
  430.    entry $window.filter_fr.entry -width 15 -bg $TEXT_COLOUR \
  431.       -textvariable g_selected_file_filter
  432.    button $window.filter_fr.filter -text "Filter" -command \
  433.       MH_PopulateFileSelect 
  434.    pack $window.filter_fr.label $window.filter_fr.entry \
  435.       $window.filter_fr.filter -side left \
  436.       -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING
  437.  
  438.    # Create the directory list and file list
  439.    frame $window.list_fr
  440.    pack $window.list_fr -fill both -expand true
  441.     set dirlist [MH_ScrolledList $window.list_fr.dir_fr 0 10 browse 0]
  442.     set filelist [MH_ScrolledList $window.list_fr.file_fr 0 10 browse 0]
  443.     $dirlist configure -bg $TEXT_COLOUR
  444.     $filelist configure -bg $TEXT_COLOUR
  445.     pack forget $window.list_fr.dir_fr $window.list_fr.file_fr
  446.     pack $window.list_fr.dir_fr $window.list_fr.file_fr -side left -fill \
  447.       both -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  448.       -expand true
  449.  
  450.    # Create a frame to display the current directory
  451.    frame $window.dir_fr -borderwidth $RIDGE_BORDER -relief groove
  452.    pack $window.dir_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  453.       -side top -fill x
  454.    label $window.dir_fr.label -text "Directory : "
  455.    label $window.dir_fr.dir 
  456.    pack $window.dir_fr.label $window.dir_fr.dir -side left \
  457.       -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING -fill x
  458.  
  459.    # Create a frame containing an entry field
  460.    frame $window.sel_fr -borderwidth $RIDGE_BORDER -relief groove
  461.    pack $window.sel_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  462.       -side top -fill x
  463.    label $window.sel_fr.label -text "File"
  464.    set entry [entry $window.sel_fr.entry -width 30 -bg $TEXT_COLOUR]
  465.    pack $window.sel_fr.label $window.sel_fr.entry -side left \
  466.       -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING -fill x
  467.  
  468.    # And add buttons to the window
  469.    set frame [frame $window.button_fr]
  470.    pack $frame -side bottom -fill x
  471.    button $frame.close -text Cancel -command {
  472.       destroy .fileselect
  473.       set g_selected_file ""
  474.    }
  475.    button $frame.ok -text OK -command {
  476.       set file [.fileselect.sel_fr.entry get]
  477.       set dir [pwd]
  478.       set g_selected_file "$dir/$file"
  479.       destroy .fileselect
  480.    }
  481.    bind $window.sel_fr.entry <Return> "$frame.ok invoke"
  482.    pack $frame.ok $frame.close -side right -padx $DEFAULT_PADDING -pady \
  483.       $DEFAULT_PADDING
  484.  
  485.    # Retrieve the list
  486.    MH_PopulateFileSelect
  487.  
  488.    # And now centre it on its parent
  489.    MH_CentreDialog $window widget .
  490.    focus $window.sel_fr.entry
  491.  
  492.    # Add bindings on list
  493.     bind $dirlist <Double-ButtonRelease-1> {
  494.       set page [.fileselect.list_fr.dir_fr.list get \
  495.          [.fileselect.list_fr.dir_fr.list curselection]]
  496.       if {$page == ".."} {cd ..} else {cd $page}
  497.       MH_PopulateFileSelect
  498.    }
  499.     bind $filelist <Double-ButtonRelease-1> {
  500.       set page [.fileselect.list_fr.file_fr.list get \
  501.          [.fileselect.list_fr.file_fr.list curselection]]
  502.       after 400 destroy .fileselect
  503.       set dir [pwd]
  504.       set g_selected_file "$dir/$page"
  505.    }
  506.     bind $filelist <ButtonRelease-1> {
  507.       set page [.fileselect.list_fr.file_fr.list get \
  508.          [.fileselect.list_fr.file_fr.list curselection]]
  509.       .fileselect.sel_fr.entry delete 0 end
  510.       .fileselect.sel_fr.entry insert end "$page"
  511.    }
  512.  
  513.    # Wait for destruction of window
  514.    tkwait variable g_selected_file
  515.    return $g_selected_file
  516. }
  517.  
  518. ###############################################################
  519. # The procedure for selecting a file
  520. proc MH_PopulateFileSelect { } {
  521.  
  522.    # Globals 
  523.    global g_selected_file_filter 
  524.    set filter $g_selected_file_filter
  525.  
  526.    # Retrieve new information
  527.    set files [lsort [glob -nocomplain $filter]]
  528.    set dirs [lsort [glob -nocomplain "*"]]
  529.    .fileselect.list_fr.dir_fr.list delete 0 end
  530.    .fileselect.list_fr.dir_fr.list insert end ".."
  531.    .fileselect.list_fr.file_fr.list delete 0 end
  532.  
  533.    # Loop through returned items
  534.    foreach file $files {
  535.       if ![file isdirectory $file] {
  536.          .fileselect.list_fr.file_fr.list insert end $file
  537.       }
  538.    }
  539.    foreach file $dirs {
  540.       if [file isdirectory $file] {
  541.          .fileselect.list_fr.dir_fr.list insert end $file
  542.       }
  543.    }
  544.  
  545.    # Set the current directory
  546.    .fileselect.dir_fr.dir configure -text [pwd]
  547. }
  548.  
  549. ###############################################################
  550. # Procedure to open a help file
  551. proc MH_OpenProject { } {
  552.  
  553.    # Globals
  554.    global RIDGE_BORDER DEFAULT_PADDING TEXT_COLOUR \
  555.       gb_current_page_changed gb_project_changed \
  556.       gs_current_project
  557.  
  558.    # Check for changes to the project
  559.    if {$gb_current_page_changed || $gb_project_changed} {
  560.       if [MH_QuestionDialog . "The project has changed.  Do
  561. you wish to discard changes?" "Discard" "Cancel"] {
  562.          # User requested cancel
  563.          return
  564.       }
  565.    }
  566.  
  567.    # Prompt for the project to open
  568.    set gs_current_project [MH_FileSelect "Open Project"]
  569.    if {$gs_current_project != ""} {MH_ReadProject}
  570. }
  571.  
  572. ###############################################################
  573. # Procedure to open a help file
  574. proc MH_ReadProject { } {
  575.  
  576.    # Globals
  577.    global gas_pages gs_current_project gas_history \
  578.       gt_mini_help gb_current_page_changed \
  579.       gb_project_changed
  580.  
  581.    # Get the file name
  582.    set file $gs_current_project
  583.    if {[file exists $file] == 1} {
  584.       # If current information exists, delete it.
  585.       set current_pages [info globals "gs_HELPTEXT_*"]
  586.       foreach page $current_pages {
  587.          global $page
  588.          unset $page
  589.       }
  590.  
  591.       # Blank old information
  592.       $gt_mini_help configure -state normal
  593.       $gt_mini_help delete 1.0 end
  594.       $gt_mini_help configure -state disabled
  595.       .name_fr.name configure -state normal
  596.       .name_fr.name delete 0 end
  597.       .name_fr.name configure -state disabled
  598.  
  599.       # Source the new file
  600.       if [catch {uplevel #0 "source $file"}] {
  601.          # Error reading file - probably not a help archive
  602.          MH_InfoDialog . "File does not have the correct format.
  603. Are you sure that this is a valid halp archive?"
  604.          set gs_current_project ""
  605.          return
  606.       }
  607.  
  608.       # Build up a list of new pages
  609.       set gas_pages [info globals "gs_HELPTEXT_*"]
  610.       set gas_history ""
  611.       set gb_current_page_changed 0
  612.       set gb_project_changed 0
  613.  
  614.       # Display the page selector
  615.       MH_SelectHelpPage FULL
  616.  
  617.       # Save the project name
  618.       wm title . "Edit Help - $file"
  619.  
  620.    } else {
  621.       # File does not exist
  622.       MH_InfoDialog . " File $file does not exist"
  623.       set gs_current_project ""
  624.    }
  625. }
  626.  
  627. ###############################################################
  628. # Procedure to save a help file
  629. proc MH_SaveProject { {name ""} } {
  630.  
  631.    # Globals
  632.    global gas_pages gb_project_changed gb_page_autocommit \
  633.       gb_current_page_changed gs_current_project
  634.  
  635.    # Check the name for syntactic correctness
  636.    if {[llength [split $name]] > 1 || [regexp -nocase \
  637.       {[`|!$%^&*()|~<>,]+} $name] || $name == ""} {
  638.       MH_InfoDialog . "Chosen name is not valid.
  639. The project has not been saved."
  640.       return
  641.    }
  642.  
  643.    # If project does not have a name pop
  644.    # up the save project as dialog.
  645.    if {$name == ""} {
  646.       MH_SaveProjectAs
  647.       return
  648.    }
  649.  
  650.    # If the current page has been changed, ask the user if
  651.    # (s)he wishes to save the changes to the current page
  652.    # before saving.
  653.    if {$gb_current_page_changed == 1} {
  654.       if {$gb_page_autocommit == 1 || [MH_QuestionDialog . \
  655.          "The current page has changed.  Do you wish
  656.  to save these changes with the project?" "No" "Yes"]} {
  657.          MH_SaveHelpPage
  658.       }
  659.    }
  660.  
  661.    # Open the file
  662.    if [catch {set fp [open $name w]}] {
  663.       MH_InfoDialog . "Unable to open file $name for writing"
  664.       return
  665.    }
  666.  
  667.    # Write the header
  668.    puts $fp "###############################################################
  669. #
  670. # THIS FILE WAS PRODUCES USING MINI HELP VERSION 1.0
  671. #
  672. # The file may be edited by hand but is best and most 
  673. # easily editied using the mini-help editor.
  674. #
  675. # The help text uses a minor subset of the html command
  676. # language.  The following constructs are supported:
  677. # 
  678. # <TITLE> Text </TITLE> - Centre's, bolds and underlines
  679. # <XREF gs_help_string_ref> Text </XREF> - Hyperlinks
  680. #
  681. # <B> Text </B> - Bold
  682. # <I> Text </I> - Italic
  683. # <TT> Text </TT> - Sans serif
  684. # <UL> Text </UL> - Underline
  685. #
  686. # <CENTER> Text </CENTER> - Centre Justify
  687. # <LEFT> Text </LEFT> - Left Justify
  688. # <RIGHT> Text </RIGHT> - Right Justify
  689. #
  690. ###############################################################
  691.  
  692. "
  693.    # Now write the help text itself
  694.    foreach page $gas_pages {
  695.       global $page
  696.       set text [eval subst \$$page]
  697.       puts $fp "global $page
  698. set $page \\
  699. \\
  700. \"$text\"
  701. "
  702.    }
  703.  
  704.    # Flush the file
  705.    flush $fp
  706.    close $fp
  707.  
  708.    # Inform the user
  709.    MH_InfoDialog . "Help saved to file $name"
  710.    set gb_project_changed 0
  711.    set gs_current_project $name
  712.    wm title . "Edit Help - $name"
  713. }
  714.  
  715. ###############################################################
  716. # Procedure to save a help file
  717. proc MH_SaveProjectAs { } {
  718.  
  719.    # Globals
  720.    global RIDGE_BORDER DEFAULT_PADDING gs_new_project_name \
  721.       TEXT_COLOUR
  722.  
  723.    # Prompt for the project to save as
  724.    set gs_new_project_name [MH_FileSelect "Save Project As..."]
  725.    if [file exists $gs_new_project_name] {
  726.       if [MH_QuestionDialog . "Are you sure you wish to overwrite
  727. file $gs_new_project_name ?" "Yes" "No"] {
  728.          MH_InfoDialog . "Help not saved"
  729.          return
  730.       }
  731.    }
  732.  
  733.    # Check validity of name
  734.    if {$gs_new_project_name != ""} {
  735.       MH_SaveProject $gs_new_project_name
  736.    } else {
  737.       MH_InfoDialog . "You must choose a name for
  738. your new help archive!"
  739.    }
  740. }
  741.  
  742. ###############################################################
  743. # Procedure to close a help file
  744. proc MH_CloseProject { b_exit } {
  745.  
  746.    # Globals
  747.    global gb_current_page_changed gb_project_changed gas_pages \
  748.       gs_current_project gs_new_project_name gs_MH_NewHelpPage \
  749.       gt_mini_help
  750.  
  751.    # Check for changes to the project
  752.    if {$gb_current_page_changed || $gb_project_changed} {
  753.       if [MH_QuestionDialog . "The project has changed.  Do
  754. you wish to discard changes?" "Discard" "Cancel"] {
  755.          # User requested cancel
  756.          return
  757.       }
  758.    }
  759.  
  760.    # Rest all variables, and destroy all globals
  761.    foreach page $gas_pages {
  762.       global $page
  763.       unset $page
  764.    }
  765.    set gas_pages ""
  766.    set gb_current_page_changed 0
  767.    set gb_project_changed      0
  768.    set gs_current_project      ""
  769.    set gs_new_project_name     ""
  770.    set gs_MH_NewHelpPage        ""
  771.    wm title . "Edit Help - <no project>"
  772.  
  773.    # Reset all user fields
  774.    $gt_mini_help configure -state normal
  775.    $gt_mini_help delete 1.0 end
  776.    $gt_mini_help configure -state disabled
  777.    .name_fr.name configure -state normal
  778.    .name_fr.name delete 0 end
  779.    .name_fr.name configure -state disabled
  780.    
  781.    # If the argument is 1, the user is trying to exit
  782.    if {$b_exit == 1} {destroy .}
  783. }
  784.  
  785. ###############################################################
  786. # The procedure to let you select a page
  787. proc MH_SelectHelpPage { type } {
  788.  
  789.    # Type may be HISTORY or FULL
  790.  
  791.    # Globals
  792.    global RIDGE_BORDER DEFAULT_PADDING TEXT_COLOUR \
  793.       gas_history gas_pages
  794.  
  795.    # Test for window
  796.    # Popup a selection window
  797.    set window .select_help
  798.    if [winfo exists $window] {
  799.        # Pop it up!
  800.        wm deiconify $window
  801.        raise $window
  802.        update
  803.        return
  804.    }
  805.  
  806.    toplevel $window
  807.    if {$type == "HISTORY"} {
  808.       wm title $window "History"
  809.       set as_list $gas_history
  810.     } else {
  811.         wm title $window "Select Page"
  812.         set as_list $gas_pages
  813.     }
  814.     wm transient $window .
  815.  
  816.     # Create a frame containing a list
  817.     frame $window.sel_fr -borderwidth $RIDGE_BORDER -relief groove
  818.     pack $window.sel_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  819.         -side top -fill x
  820.     set list [MH_ScrolledList $window.list_fr 0 10 browse 0]
  821.     $list configure -bg $TEXT_COLOUR
  822.     pack forget $window.list_fr
  823.     pack $window.list_fr -side top -fill both -padx $DEFAULT_PADDING \
  824.         -pady $DEFAULT_PADDING -expand true
  825.  
  826.     # Add the help pages title to the list
  827.     foreach item $as_list {
  828.         # Get the help text title for the page
  829.         set text "Unknown Help Page"
  830.         global $item
  831.         set local_text [eval subst {\$$item}]
  832.         set start [string first "<title>" $local_text]
  833.         if {$start == -1} {set start [string first "<TITLE>" $local_text]}
  834.         set end [string first "</title>" $local_text]
  835.         if {$end == -1} {set end [string first "</TITLE>" $local_text]}
  836.  
  837.         if {$start != -1} {
  838.             set start [expr [string wordend $local_text [expr $start + 1]] +1]
  839.             set end [expr [string wordstart $local_text $end] -1]
  840.             set text [string range $local_text $start $end]
  841.             set text [string trimleft $text]
  842.         } else {
  843.             MH_InfoDialog . "Error in help text (${item})!  
  844. All pages must begin with a title e.g. 
  845. <title>Contents</title> or
  846. <TITLE>Contents</TITLE>"
  847.         }
  848.         $list insert end $text
  849.     }
  850.  
  851.     # Now for a goto, close and contents button
  852.     set frame [frame $window.button_fr]
  853.     pack $frame -side bottom -fill x
  854.     button $frame.close -text Close -command "destroy $window"
  855.     button $frame.new -text New -command "destroy $window; MH_NewHelpPage"
  856.     button $frame.goto -text Goto -command "MH_SelectPageFromList $type"
  857.     bind $list <Double-ButtonRelease-1> "MH_SelectPageFromList $type"
  858.     pack $frame.close $frame.new $frame.goto -side right \
  859.         -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING
  860.  
  861.     # And now centre it on its parent
  862.     MH_CentreDialog $window widget .
  863. }
  864.  
  865. ###############################################################
  866. # The procedure to navigate backwards through the history
  867. proc MH_SelectPageFromList { type } {
  868.  
  869.    # Globals
  870.    global gas_history gas_pages
  871.  
  872.     set page [.select_help.list_fr.list curselection]
  873.     if {$page == ""} {
  874.         return
  875.     } else {
  876.  
  877.         # Type may be HISTORY or FULL
  878.         if {$type == "HISTORY"} {
  879.             set as_list $gas_history
  880.       } else {
  881.          set as_list $gas_pages
  882.       }
  883.  
  884.       set name [lindex $as_list $page]
  885.       if {$type == "HISTORY"} {set gas_history \
  886.          [lreplace $gas_history $page end]}
  887.       MH_DisplayHelpPage $name
  888.       after 400 destroy .select_help
  889.    }
  890. }
  891.  
  892. ###############################################################
  893. # The procedure to navigate backwards through the history
  894. proc MH_EditNavigateBack {} {
  895.  
  896.    # Globals
  897.    global gas_history
  898.  
  899.    # The list gas_history contains a list of all help pages
  900.    # visited.  Simply extract the second to last page, and
  901.    # delete the last item in the list, then dislpay the 
  902.    # page.
  903.    # MH_InfoDialog . $gas_history
  904.    if {[llength $gas_history] < 2} {
  905.       # Nowhere to return to
  906.       return
  907.    }
  908.    
  909.    # Get the last page
  910.    set help [lindex $gas_history [expr [llength $gas_history] - 2]]
  911.  
  912.    # Delete the two last items (note that one of them is recreated
  913.    # when we call MH_DisplayHelpPage).
  914.    set gas_history [lreplace $gas_history [expr [llength $gas_history] \
  915.       - 2] end]
  916.  
  917.    # And show the help page
  918.    MH_DisplayHelpPage $help
  919. }
  920.  
  921. ###############################################################
  922. # Procedure for displaying a help page
  923. proc MH_DisplayHelpPage { text } {
  924.  
  925.    # Globals
  926.    global gt_mini_help gas_pages gb_current_page_changed \
  927.       gas_history
  928.  
  929.    # Check for the existence of the page before going
  930.    # ahead...
  931.    if {[info globals $text] == ""} {
  932.       MH_InfoDialog . "Page does not exist!"
  933.       return
  934.    }
  935.  
  936.    # Display the associated help text
  937.    $gt_mini_help configure -state normal
  938.    $gt_mini_help delete 1.0 end
  939.    global $text 
  940.    $gt_mini_help insert end [eval subst \$$text]
  941.    # Parse the help (0=Edit rather than run time)
  942.    MH_ParseHelp 0
  943.    set gb_current_page_changed 0
  944.  
  945.    # Set the focus
  946.    focus $gt_mini_help
  947.  
  948.    # Display the page title in the entry
  949.    .name_fr.name configure -state normal
  950.    .name_fr.name delete 0 end
  951.    .name_fr.name insert end [string range $text 12 end]
  952.    .name_fr.name configure -state disabled
  953.    .name_fr.save configure -state disabled
  954.  
  955.    # Add to the history list (removing any other references to
  956.    # the page on the way - there will be at most one given the
  957.    # nature of the check)
  958.    set item [lsearch -exact $gas_history $text]
  959.    if {$item != -1} {set gas_history [lreplace $gas_history $item $item]}
  960.    lappend gas_history $text
  961. }
  962.  
  963. ###############################################################
  964. # Procedure for displaying a new help page
  965. proc MH_NewHelpPage { } {
  966.  
  967.    # If the variable keep_old_text is set, then 
  968.    # the text that is currently being displayed
  969.    # is retained.
  970.  
  971.    # Globals
  972.    global RIDGE_BORDER DEFAULT_PADDING gs_MH_NewHelpPage \
  973.       gt_mini_help gas_pages TEXT_COLOUR gb_keep_old_text \
  974.       gas_history
  975.  
  976.    # Popup a selection window
  977.    set window .new_page
  978.    if [winfo exists $window] {
  979.        # Pop it up!
  980.        wm deiconify $window
  981.        raise $window
  982.        return
  983.    }
  984.  
  985.    # Otherwise create the window
  986.    toplevel $window
  987.    wm title $window "New Help Page"
  988.    wm transient $window .
  989.  
  990.    # Create a frame containing a list and an entry field
  991.    frame $window.sel_fr -borderwidth $RIDGE_BORDER -relief groove
  992.    pack $window.sel_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  993.       -side top -fill x
  994.    label $window.sel_fr.label -text "Page Name"
  995.    entry $window.sel_fr.entry -width 30 -bg $TEXT_COLOUR -textvariable \
  996.       gs_MH_NewHelpPage
  997.    pack $window.sel_fr.label $window.sel_fr.entry -side left \
  998.       -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING
  999.  
  1000.    # And add buttons to the window
  1001.    set frame [frame $window.button_fr]
  1002.    pack $frame -side bottom -fill x
  1003.    button $frame.close -text Cancel -command "wm withdraw $window"
  1004.    button $frame.ok -text OK -command {
  1005.       # Check the name for syntactic correctness
  1006.       if {[llength [split $gs_MH_NewHelpPage]] > 1 || [regexp -nocase \
  1007.          {[`"#;:',.?/\|!$%^&*()|~<>,]+} $gs_MH_NewHelpPage] ||
  1008.          $gs_MH_NewHelpPage == ""} {
  1009.          MH_InfoDialog . "Chosen name is not valid.  Please input 
  1010. another name.  It must contain only alphanumeric
  1011. characters."
  1012.       } else {
  1013.          # Create a new global
  1014.          set variable "gs_HELPTEXT_$gs_MH_NewHelpPage"
  1015.          global $variable
  1016.          set $variable ""
  1017.          lappend gas_pages $variable
  1018.          lappend gas_history $variable
  1019.  
  1020.          # Clear the text area
  1021.          $gt_mini_help configure -state normal
  1022.          if {$gb_keep_old_text == 0} {
  1023.             $gt_mini_help delete 1.0 end
  1024.          } else {
  1025.             # Reset flag
  1026.             set gb_keep_old_text 0
  1027.          }
  1028.  
  1029.          # Display the page title in the entry
  1030.          .name_fr.name configure -state normal
  1031.          .name_fr.name delete 0 end
  1032.          .name_fr.name insert end $gs_MH_NewHelpPage
  1033.          .name_fr.name configure -state disabled
  1034.  
  1035.          # Set the focus
  1036.          focus $gt_mini_help
  1037.  
  1038.          # Page should be saved (project has changed)
  1039.          .name_fr.save configure -state normal
  1040.          set gb_current_page_changed 1
  1041.  
  1042.          # Withdraw this window
  1043.          wm withdraw .new_page
  1044.       }
  1045.    }
  1046.    bind $window.sel_fr.entry <Return> "$frame.ok invoke"
  1047.    pack $frame.ok $frame.close -side right -padx $DEFAULT_PADDING -pady \
  1048.       $DEFAULT_PADDING
  1049.  
  1050.    # And now centre it on its parent
  1051.    MH_CentreDialog $window widget .
  1052.    focus $window.sel_fr.entry
  1053. }
  1054.  
  1055. ###############################################################
  1056. # The procedure for finding tags in the help
  1057. proc MH_ShowHyperMenu { tag } {
  1058.  
  1059.    # Globals
  1060.    global gt_mini_help
  1061.  
  1062.    # Create the menu - Check for existence
  1063.    set window .hyper_popup_menu
  1064.    if [winfo exists $window] {destroy $window}
  1065.  
  1066.    # Find the start and end of the current tag
  1067.    set x [ winfo pointerx $gt_mini_help ]
  1068.    set y [ winfo pointery $gt_mini_help ]
  1069.    set curpos [$gt_mini_help index @$x,$y]
  1070.    set ranges [$gt_mini_help tag ranges $tag]
  1071.    set list_len [llength $ranges]
  1072.    for {set count 0} {$count < $list_len} {incr count 2} {
  1073.       if {$curpos >= [lindex $ranges $count]} {
  1074.          set start [lindex $ranges $count]
  1075.          set end [lindex $ranges [expr $count + 1]]
  1076.          #MH_InfoDialog . "Tag found $start $end"
  1077.       }
  1078.    }
  1079.  
  1080.    # Create the popup menu
  1081.    menu .hyper_popup_menu -tearoff 0
  1082.       $window add checkbutton -label [string range $tag 12 end] \
  1083.          -indicatoron False
  1084.       $window add separator
  1085.       $window add command -label "Open Link" -command "MH_OpenLink \
  1086.          $tag" -underline 0
  1087.       $window add command -label "Bind Link" -command "MH_BindLink \
  1088.          $tag $start $end" -underline 0
  1089.  
  1090.    # Now popup the window in place
  1091.    MH_PopupMenu . $window
  1092. }
  1093.  
  1094. ###############################################################
  1095. # The procedure for finding tags in the help
  1096. proc MH_BindLink { tag start end } {
  1097.  
  1098.    # Globals
  1099.    global gas_pages RIDGE_BORDER \
  1100.       DEFAULT_PADDING TEXT_COLOUR gt_mini_help
  1101.  
  1102.    # Test for NULL arguments.  If so, use current
  1103.    # selection...
  1104.    if {$start == ""} {
  1105.       # MH_InfoDialog . "Using current selection"
  1106.       if [catch {$gt_mini_help get sel.first}] {return}
  1107.       set start [$gt_mini_help index sel.first]
  1108.       set end [$gt_mini_help index sel.last]
  1109.  
  1110.       # Ensure that the current selection has not
  1111.       # already got a hyperlink tag
  1112.       MH_RemoveTags XREF
  1113.    }
  1114.    if {$tag == ""} {set tag NONE}
  1115.  
  1116.    # Test for window
  1117.    # Popup a selection window
  1118.    set window .bind_hyperlink
  1119.    if [winfo exists $window] {destroy $window}
  1120.    toplevel $window
  1121.    wm title $window "Select Hyperlink"
  1122.    wm transient $window .
  1123.  
  1124.    # Create a frame containing a list
  1125.    frame $window.sel_fr -borderwidth $RIDGE_BORDER -relief groove
  1126.    pack $window.sel_fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING \
  1127.       -side top -fill x
  1128.    set list [MH_ScrolledList $window.list_fr 0 10 browse 0]
  1129.    $list configure -bg $TEXT_COLOUR
  1130.    pack forget $window.list_fr
  1131.    pack $window.list_fr -side top -fill both -padx $DEFAULT_PADDING \
  1132.       -pady $DEFAULT_PADDING -expand true
  1133.  
  1134.    # MH_InfoDialog . $gas_pages
  1135.    # Add the help pages title to the list
  1136.    foreach item $gas_pages {
  1137.       # Get the help text title for the page
  1138.       set text "Unknown Help Page"
  1139.       global $item
  1140.       set local_text [eval subst {\$$item}]
  1141.       set p1 [string first "<title>" $local_text]
  1142.       if {$p1 == -1} {set p1 [string first "<TITLE>" $local_text]}
  1143.       set p2 [string first "</title>" $local_text]
  1144.       if {$p2 == -1} {set p2 [string first "</TITLE>" $local_text]}
  1145.  
  1146.       if {$p1 != -1} {
  1147.          set p1 [expr [string wordend $local_text [expr $p1 + 1]] +1]
  1148.          set p2 [expr [string wordstart $local_text $p2] -1]
  1149.          set text [string range $local_text $p1 $p2]
  1150.          set text [string trimleft $text]
  1151.       } else {
  1152.          MH_InfoDialog . "Error in help text (${item})!  
  1153. All pages must begin with a title e.g. 
  1154. <title>Contents</title> or
  1155. <TITLE>Contents</TITLE>"
  1156.       }
  1157.       set page [string range $item 12 end]
  1158.       $list insert end "$text - $page"
  1159.    }
  1160.  
  1161.    # Now for a goto, close and contents button
  1162.    set frame [frame $window.button_fr]
  1163.    pack $frame -side bottom -fill x
  1164.    button $frame.cancel -text Cancel -command "destroy $window"
  1165.    button $frame.bind -text OK -command "MH_Create_Link $tag $start $end"
  1166.    pack $frame.cancel $frame.bind -side right \
  1167.       -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING
  1168.  
  1169.    # And now centre it on its parent
  1170.    MH_CentreDialog $window widget .
  1171. }
  1172.  
  1173. ###############################################################
  1174. # The procedure for opening a tag in the help
  1175. proc MH_Create_Link { tag start end } {
  1176.  
  1177.    # Globals
  1178.    global gt_mini_help gas_pages RED GREEN FONT_BOLD \
  1179.       gb_current_page_changed gb_project_changed
  1180.  
  1181.    set page [.bind_hyperlink.list_fr.list curselection]
  1182.    if {$page == ""} {
  1183.       return
  1184.    } else {
  1185.       set name [lindex $gas_pages $page]
  1186.       if {$tag != "NONE"} {
  1187.          $gt_mini_help tag remove $tag $start $end
  1188.       }
  1189.       $gt_mini_help tag add $name $start $end
  1190.       $gt_mini_help tag configure $name -foreground \
  1191.          $GREEN -font $FONT_BOLD
  1192.       $gt_mini_help tag bind $name <Enter> \
  1193.          "$gt_mini_help tag configure $name -foreground $RED"
  1194.       $gt_mini_help tag bind $name <Leave> \
  1195.          "$gt_mini_help tag configure $name -foreground $GREEN"
  1196.       $gt_mini_help tag bind $name <ButtonPress> "MH_ShowHyperMenu $name"
  1197.  
  1198.       # Page has changed
  1199.       set gb_project_changed      1
  1200.       set gb_current_page_changed 1
  1201.       .name_fr.save configure -state normal
  1202.  
  1203.       # Destroy the popup
  1204.       destroy .bind_hyperlink
  1205.    }
  1206. }
  1207.  
  1208. ###############################################################
  1209. # The procedure for opening a tag in the help
  1210. proc MH_OpenLink { tag } {
  1211.  
  1212.    # Globals
  1213.    global gb_current_page_changed gb_page_autocommit
  1214.  
  1215.    # Check for changed
  1216.    if {$gb_current_page_changed == 0 || $gb_page_autocommit == 1} {
  1217.       MH_SaveHelpPage
  1218.       MH_DisplayHelpPage $tag
  1219.    } else {
  1220.       if ![MH_QuestionDialog . "Help text on this page has changed!" \
  1221.          "Discard Changes" "Cancel"] {
  1222.          MH_DisplayHelpPage $tag
  1223.       }
  1224.    }
  1225. }
  1226.  
  1227. ###############################################################
  1228. # The procedure for finding tags in the help
  1229. proc MH_RenamePage { } {
  1230.  
  1231.    # Global
  1232.    global gb_keep_old_text gas_history gas_pages
  1233.  
  1234.    # Popup a warning dialogue
  1235.    MH_InfoDialog . "All references to this page must be regenerated!"
  1236.  
  1237.    # All we need do is to call MH_NewHelpPage, asking the
  1238.    # routine to retain the current information.  Then
  1239.    # we delete the old variable reference.
  1240.    set gb_keep_old_text 1
  1241.    set name [.name_fr.name get]
  1242.    set name "gs_HELPTEXT_$name"
  1243.    global $name
  1244.    unset $name
  1245.  
  1246.    # Delete from history, and delete from list of pages
  1247.    set location [lsearch -exact $gas_pages $name]
  1248.    if {$location != -1} {
  1249.       set gas_pages [lreplace $gas_pages $location $location]
  1250.    }
  1251.    set location [lsearch -exact $gas_history $name]
  1252.    if {$location != -1} {
  1253.       set gas_history [lreplace $gas_history $location $location]
  1254.    }
  1255.  
  1256.    # Create the new page
  1257.    MH_NewHelpPage
  1258.    # Fill the field with default information, and
  1259.    # disable the cancel button
  1260.    wm title .new_page "Rename Page"
  1261.    .new_page.sel_fr.entry delete 0 end
  1262.    .new_page.sel_fr.entry insert end [.name_fr.name get]
  1263.    pack forget .new_page.button_fr.close
  1264. }
  1265.  
  1266. ###############################################################
  1267. # The procedure for finding tags in the help
  1268. proc MH_Create_Help { } {
  1269.  
  1270.    # Globals
  1271.    global gt_mini_help search FONT_BOLD FONT_ITALIC \
  1272.       FIXED_FONT TEXT_COLOUR
  1273.  
  1274.    # Format list
  1275.    set format_list [list TITLE BOLD ITALIC FIXED UNDERLINE CENTER \
  1276.       LEFT RIGHT]
  1277.  
  1278.    # Keyworks
  1279.    set TITLE "TITLE"
  1280.    set BOLD  "B"
  1281.    set ITALIC "I"
  1282.    set FIXED "TT"
  1283.    set UNDERLINE "U"
  1284.    set CENTER "CENTER"
  1285.    set LEFT "LEFT"
  1286.    set RIGHT "RIGHT"
  1287.  
  1288.    # Loop round the declared types
  1289.    foreach type $format_list {
  1290.       # Note that location here is a two element list
  1291.       set location [$gt_mini_help tag nextrange $type 1.0]
  1292.       set format [eval subst \$$type]
  1293.       # MH_InfoDialog . $location
  1294.       while {$location != ""} {
  1295.          # Replace the tagged area with the formatting
  1296.          # instructions
  1297.          $gt_mini_help tag remove $type [lindex $location 0] \
  1298.             [lindex $location 1]
  1299.          $gt_mini_help insert [lindex $location 1] "</$format>"
  1300.          $gt_mini_help insert [lindex $location 0] "<$format>"
  1301.          set location [$gt_mini_help tag nextrange $type 1.0]
  1302.       }
  1303.    }
  1304.  
  1305.    # Now save the hyperlinks - get a tag list and extract
  1306.    # all non-hyperlink tags.
  1307.    set tags [$gt_mini_help tag names]
  1308.    lappend format_list sel
  1309.    foreach format $format_list {
  1310.       while {[lsearch -exact $tags $format] != -1} {
  1311.          set position [lsearch -exact $tags $format]
  1312.          set tags [lreplace $tags $position $position]
  1313.       }
  1314.    }
  1315.    #MH_InfoDialog . $tags
  1316.    foreach type $tags {
  1317.       # For each range in question, tag the selection
  1318.       set location [$gt_mini_help tag nextrange $type 1.0]
  1319.       # MH_InfoDialog . $location
  1320.       while {$location != ""} {
  1321.          # Replace the tagged area with the formatting
  1322.          # instructions
  1323.          $gt_mini_help tag remove $type [lindex $location 0] \
  1324.             [lindex $location 1]
  1325.          $gt_mini_help insert [lindex $location 1] "</XREF>"
  1326.          $gt_mini_help insert [lindex $location 0] "<XREF $type>"
  1327.          set location [$gt_mini_help tag nextrange $type 1.0]
  1328.       }
  1329.    }
  1330.  
  1331.    # Disable text by default
  1332.    $gt_mini_help configure -state disabled
  1333. }
  1334.  
  1335. ###############################################################
  1336. # The procedure for finding tags in the help
  1337. proc MH_SaveHelpPage { } {
  1338.  
  1339.    # Globals
  1340.    global gt_mini_help gb_current_page_changed \
  1341.       gb_show_formatted
  1342.  
  1343.    # Create the tagged text
  1344.    MH_Create_Help
  1345.  
  1346.    # Now save to the variable
  1347.    set name [.name_fr.name get]
  1348.    set name "gs_HELPTEXT_$name"
  1349.    global $name
  1350.    set text [$gt_mini_help get 1.0 end]
  1351.    set $name $text
  1352.  
  1353.    # If show is true, redisplay the text in formatted form.
  1354.    # Otherwise, leave unformatted.
  1355.    if {$gb_show_formatted == 1} {
  1356.       # Now redisplay the text and disable the save button
  1357.       $gt_mini_help configure -state normal
  1358.       MH_ParseHelp 0
  1359.    }
  1360.  
  1361.    # Reset status
  1362.    .name_fr.save configure -state disabled
  1363.    set gb_current_page_changed 0
  1364. }
  1365.  
  1366. ###############################################################
  1367. # The procedure for finding tags in the help
  1368. proc MH_DeleteHelpPage { name } {
  1369.  
  1370.    # Globals
  1371.    global gas_pages gt_mini_help gb_current_page_changed \
  1372.       gb_project_changed
  1373.    set page "gs_HELPTEXT_$name"
  1374.    global $page
  1375.    
  1376.    # Ask the user for confirmation
  1377.    if ![MH_QuestionDialog . "Do you really want to delete page '$name'?" \
  1378.       "Delete" "Cancel"] {
  1379.       # Perform deletion.
  1380.       unset $page
  1381.       set item [lsearch -exact $gas_pages $page]
  1382.       set gas_pages [lreplace $gas_pages $item $item]
  1383.       set gas_history [lreplace $gas_history $item $item]
  1384.  
  1385.       # And blank out the edit areas of the screen
  1386.       $gt_mini_help configure -state normal
  1387.       $gt_mini_help delete 1.0 end
  1388.       $gt_mini_help configure -state disabled
  1389.       set gb_current_page_changed 0
  1390.       set gb_project_changed 1
  1391.  
  1392.       # Display the page title in the entry
  1393.       .name_fr.name configure -state normal
  1394.       .name_fr.name delete 0 end
  1395.       .name_fr.name configure -state disabled
  1396.       .name_fr.save configure -state disabled
  1397.    }
  1398. }
  1399.  
  1400. ###############################################################
  1401. # The procedure to goto a specified page from the history
  1402. proc MH_CopyText { delete } {
  1403.  
  1404.    # Global
  1405.    global gt_mini_help gs_cut_buffer
  1406.  
  1407.    # Copy the selected text into the cut buffer, then
  1408.    # delete if the flag 'delete' is set.
  1409.    if [catch {$gt_mini_help get sel.first}] {return}
  1410.    set gs_cut_buffer [$gt_mini_help get sel.first sel.last]
  1411.  
  1412.    # And delete/allow a save if data deleted
  1413.    if {$delete == 1} { 
  1414.       $gt_mini_help delete sel.first sel.last
  1415.       set gb_project_changed      1
  1416.       set gb_current_page_changed 1
  1417.       .name_fr.save configure -state normal
  1418.    }
  1419. }
  1420.  
  1421. ###############################################################
  1422. # The procedure to goto a specified page from the history
  1423. proc MH_PasteText { } {
  1424.  
  1425.    # Global
  1426.    global gt_mini_help gs_cut_buffer
  1427.  
  1428.    # Perform paste if data exists in the cut buffer
  1429.    if {$gs_cut_buffer != ""} {
  1430.       set position [$gt_mini_help index insert]
  1431.       $gt_mini_help insert $position $gs_cut_buffer
  1432.    }
  1433. }
  1434.  
  1435. ###############################################################
  1436. # The procedure to add a tag to the current selection
  1437. proc MH_AddTag { type } {
  1438.  
  1439.    # Globals
  1440.    global gt_mini_help search FONT_BOLD FONT_ITALIC \
  1441.       FIXED_FONT TEXT_COLOUR RED GREEN gb_project_changed \
  1442.       gb_current_page_changed
  1443.  
  1444.    # Format list
  1445.    set format_list [list TITLE BOLD ITALIC FIXED UNDERLINE CENTER \
  1446.       LEFT RIGHT]
  1447.  
  1448.    # If the input argument is not in this list then it is 
  1449.    # not a valid type.
  1450.    if {[lsearch -exact $format_list $type] == -1} {
  1451.       MH_InfoDialog . "Invalid/unknown tag type specified!"
  1452.       return
  1453.    }
  1454.  
  1455.    # Keyworks and formatting
  1456.    set TITLE "TITLE"
  1457.    set TITLE_FORMAT "-font $FONT_BOLD -underline True -justify center"
  1458.    set BOLD  "B"
  1459.    set BOLD_FORMAT "-font $FONT_BOLD"
  1460.    set ITALIC "I"
  1461.    set ITALIC_FORMAT "-font $FONT_ITALIC"
  1462.    set FIXED "TT"
  1463.    set FIXED_FORMAT "-font $FIXED_FONT"
  1464.    set UNDERLINE "U"
  1465.    set UNDERLINE_FORMAT "-underline True"
  1466.    set CENTER "CENTER"
  1467.    set CENTER_FORMAT "-justify center"
  1468.    set LEFT "LEFT"
  1469.    set LEFT_FORMAT "-justify left"
  1470.    set RIGHT "RIGHT"
  1471.    set RIGHT_FORMAT "-justify right"
  1472.  
  1473.    # Get the selected text, and format with the 
  1474.    # characteristic given, flagging the block with
  1475.    # the tag.  Check for a selection first.
  1476.    if [catch {$gt_mini_help get sel.first}] {return}
  1477.  
  1478.    # Certain tags preclude other tags (e.g. justification)
  1479.    if {$type == "CENTER" || $type == "LEFT" || $type == "RIGHT"} {
  1480.       MH_RemoveTags JUSTIFY
  1481.    }
  1482.  
  1483.    # Add the new tag type
  1484.    $gt_mini_help tag add $type sel.first sel.last
  1485.    set format [eval subst \$${type}_FORMAT]
  1486.    eval $gt_mini_help tag configure $type $format
  1487.    $gt_mini_help tag raise $type
  1488.  
  1489.    # And allow a save
  1490.    set gb_project_changed      1
  1491.    set gb_current_page_changed 1
  1492.    .name_fr.save configure -state normal
  1493. }
  1494.  
  1495. ###############################################################
  1496. # The procedure to remove all tags from the current selection
  1497. proc MH_RemoveTags { type } {
  1498.  
  1499.    # Global
  1500.    global gt_mini_help FIXED_FONT gb_project_changed \
  1501.       gb_current_page_changed
  1502.  
  1503.    # Allowable values for type are:
  1504.    # XREF - Hyperlink references
  1505.    # CHARACTER - Character/font formatting
  1506.    # JUSTIFY - Justification
  1507.    # ALL - All formatting
  1508.  
  1509.    set as_character [list BOLD UNDERLINE TITLE ITALIC FIXED]
  1510.    set as_justify [list CENTER LEFT RIGHT]
  1511.    set as_non_xref [list BOLD UNDERLINE TITLE ITALIC FIXED \
  1512.       CENTER LEFT RIGHT sel]
  1513.    set delete_xref 0
  1514.    set al_del_list ""
  1515.  
  1516.    # Determine what needs to be done
  1517.    switch -exact $type {
  1518.       XREF {set delete_xref 1}
  1519.       CHARACTER {set al_del_list $as_character}
  1520.       JUSTIFY {set al_del_list $as_justify}
  1521.       ALL {set al_del_list [list [join $as_character $as_justify]]
  1522.          set delete_xref 1}
  1523.       default {
  1524.          MH_InfoDialog . "Error: Unrecognised clear command"
  1525.          return
  1526.       }
  1527.    }
  1528.  
  1529.    # Get the selected text, and unformat
  1530.    if [catch {$gt_mini_help get sel.first}] {return}
  1531.    set this [$gt_mini_help index sel.first]
  1532.    set last [$gt_mini_help index sel.last]
  1533.    while {$this != $last} {
  1534.  
  1535.       # Delete selected formatting commands
  1536.       foreach tag $al_del_list {
  1537.          #MH_InfoDialog . "Removing $tag from position $this"
  1538.          $gt_mini_help tag remove $tag $this
  1539.       }
  1540.       # If delete_xref selected find the xrefs and delete
  1541.       if {$delete_xref == 1} {
  1542.          set tags [$gt_mini_help tag names $this]
  1543.          foreach tag $as_non_xref {
  1544.             set loc [lsearch -exact $tags $tag]
  1545.             if {$loc != -1} {set tags [lreplace $tags $loc $loc]}
  1546.          }
  1547.          foreach xref $tags {
  1548.             #MH_InfoDialog . "Removing xref $tag from position $this"
  1549.             $gt_mini_help tag remove $xref $this
  1550.          }
  1551.       }
  1552.  
  1553.       # Increment to the next character
  1554.       set this [$gt_mini_help index "$this + 1 chars"]
  1555.    }
  1556.  
  1557.    # And allow a save
  1558.    set gb_project_changed      1
  1559.    set gb_current_page_changed 1
  1560.    .name_fr.save configure -state normal
  1561. }
  1562.  
  1563. ###############################################################
  1564. # Show the main interface
  1565. ###############################################################
  1566.  
  1567. # Source other files
  1568. MH_SourceOther MiniHelp_Runtime.tcl
  1569.  
  1570. # Create the mini-help screen
  1571. wm title . "Edit Help - <no project>"
  1572. wm geometry . $TKNET_HELP_GEOMETRY
  1573. wm protocol . WM_DELETE_WINDOW "MH_CloseProject 1"
  1574.  
  1575. ###########################################################################
  1576. # Create Menu Bar
  1577. frame .mbar -relief raised -bd 2
  1578. pack .mbar -side top -fill x
  1579.  
  1580. # Create the buttons   
  1581. menubutton .mbar.file -text File -underline 0 -menu .mbar.file.menu
  1582. menubutton .mbar.edit -text Edit -underline 0 -menu .mbar.edit.menu
  1583. menubutton .mbar.format -text Format -underline 0 -menu .mbar.format.menu
  1584. menubutton .mbar.justify -text Justify -underline 0 -menu .mbar.justify.menu
  1585. menubutton .mbar.page -text Page -underline 0 -menu .mbar.page.menu
  1586. menubutton .mbar.navigate -text Navigate -underline 0 -menu .mbar.navigate.menu
  1587. menubutton .mbar.options -text Options -underline 0 -menu .mbar.options.menu
  1588. pack .mbar.file .mbar.edit .mbar.format .mbar.justify .mbar.page \
  1589.    .mbar.navigate .mbar.options -side left
  1590.  
  1591. # Create each menu item
  1592. menu .mbar.file.menu -tearoff 0
  1593.    .mbar.file.menu add command -label "Open" -command \
  1594.       "MH_OpenProject" -underline 0 -accelerator "Ctrl-O"
  1595.    .mbar.file.menu add command -label "Close" -command \
  1596.       "MH_CloseProject 0" -underline 0
  1597.    .mbar.file.menu add separator
  1598.    .mbar.file.menu add command -label "Save" -command \
  1599.       {MH_SaveProject $gs_current_project} -underline 0
  1600.    .mbar.file.menu add command -label "Save As..." -command "MH_SaveProjectAs" -underline 0
  1601.    .mbar.file.menu add separator
  1602.    .mbar.file.menu add command -label "Exit" -command "MH_CloseProject 1" -underline 0
  1603. menu .mbar.edit.menu -tearoff 0
  1604.    .mbar.edit.menu add command -label "Cut" -command \
  1605.       "MH_CopyText 1" -underline 2 -accelerator "Ctrl-X"
  1606.    .mbar.edit.menu add command -label "Copy" -command \
  1607.       "MH_CopyText 0" -underline 0 -accelerator "Ctrl-C"
  1608.    .mbar.edit.menu add command -label "Paste" -command \
  1609.       "MH_PasteText" -underline 0 -accelerator "Ctrl-V"
  1610.    .mbar.edit.menu add separator
  1611.    .mbar.edit.menu add command -label "Remove Link" -command \
  1612.       "MH_RemoveTags XREF" -underline 0
  1613.    .mbar.edit.menu add command -label "Remove Formatting" -command \
  1614.       "MH_RemoveTags CHARACTER" -underline 0
  1615.    .mbar.edit.menu add command -label "Remove Justification" -command \
  1616.       "MH_RemoveTags JUSTIFY" -underline 0
  1617.    .mbar.edit.menu add command -label "Remove All" -command \
  1618.       "MH_RemoveTags ALL" -underline 0
  1619. menu .mbar.format.menu -tearoff 0
  1620.    .mbar.format.menu add command -label Bold -command "MH_AddTag BOLD" \
  1621.       -underline 0 -accelerator "Ctrl-B"
  1622.    .mbar.format.menu add command -label Italic -command \
  1623.       "MH_AddTag ITALIC" -underline 0 -accelerator "Ctrl-I"
  1624.    .mbar.format.menu add command -label Underline -command \
  1625.       "MH_AddTag UNDERLINE" -underline 0 -accelerator "Ctrl-U"
  1626.    .mbar.format.menu add command -label Serif -command \
  1627.       "MH_AddTag FIXED" -underline 0 -accelerator "Ctrl-S"
  1628.    .mbar.format.menu add separator
  1629.    .mbar.format.menu add command -label Title -command \
  1630.       "MH_AddTag TITLE" -underline 0 -accelerator "Ctrl-T"
  1631.    .mbar.format.menu add command -label Hyperlink... -command \
  1632.       {MH_BindLink "" "" ""} -underline 0 -accelerator "Ctrl-L"
  1633. menu .mbar.justify.menu -tearoff 0
  1634.    .mbar.justify.menu add command -label Centre -command \
  1635.       "MH_AddTag CENTER" -underline 0
  1636.    .mbar.justify.menu add command -label Left -command \
  1637.       "MH_AddTag LEFT" -underline 0
  1638.    .mbar.justify.menu add command -label Right -command \
  1639.       "MH_AddTag RIGHT" -underline 0
  1640. menu .mbar.page.menu -tearoff 0
  1641.    .mbar.page.menu add command -label New -command {
  1642.       if {$gb_current_page_changed == 0 || $gb_page_autocommit == 1} {
  1643.          MH_SaveHelpPage
  1644.          MH_NewHelpPage 
  1645.       } else {
  1646.          if ![MH_QuestionDialog . "Help text on this page has changed!" \
  1647.             "Discard Changes" "Cancel"] {
  1648.             MH_NewHelpPage 
  1649.          }
  1650.       }
  1651.    } -underline 0
  1652.    .mbar.page.menu add command -label "Rename ..." -command \
  1653.       {MH_RenamePage} -underline 0
  1654.    .mbar.page.menu add command -label Delete -command {
  1655.       set name [.name_fr.name get]
  1656.       if {$name != ""} {
  1657.          MH_DeleteHelpPage $name
  1658.       }
  1659.    } -underline 0
  1660.    .mbar.page.menu add separator
  1661.    .mbar.page.menu add checkbutton -label "Display Formatted" -command {
  1662.       if {$gb_show_formatted == 1} {
  1663.          MH_ParseHelp 0
  1664.       } else {
  1665.          MH_Create_Help
  1666.       }
  1667.    } -variable gb_show_formatted
  1668. menu .mbar.navigate.menu -tearoff 0
  1669.    .mbar.navigate.menu add command -label "Previous Page" -command {
  1670.       if {$gb_current_page_changed == 0 || $gb_page_autocommit == 1} {
  1671.          MH_SaveHelpPage
  1672.          MH_EditNavigateBack
  1673.       } else {
  1674.          if ![MH_QuestionDialog . "Help text on this page has changed!" \
  1675.             "Discard Changes" "Cancel"] {
  1676.             MH_EditNavigateBack
  1677.          }
  1678.       }
  1679.    } -underline 0 -accelerator "Ctrl-P"
  1680.    .mbar.navigate.menu add command -label "History ..." -command {
  1681.       if {$gb_current_page_changed == 0 || $gb_page_autocommit == 1} {
  1682.          MH_SaveHelpPage
  1683.          MH_SelectHelpPage HISTORY
  1684.       } else {
  1685.          if ![MH_QuestionDialog . "Help text on this page has changed!" \
  1686.             "Discard Changes" "Cancel"] {
  1687.             MH_SelectHelpPage HISTORY
  1688.          }
  1689.       }
  1690.    } -underline 0 -accelerator "Ctrl-H"
  1691.    .mbar.navigate.menu add command -label "Select Page ..." -command {
  1692.       if {$gb_current_page_changed == 0 || $gb_page_autocommit == 1} {
  1693.          MH_SaveHelpPage
  1694.          MH_SelectHelpPage FULL
  1695.       } else {
  1696.          if ![MH_QuestionDialog . "Help text on this page has changed!" \
  1697.             "Discard Changes" "Cancel"] {
  1698.             MH_SelectHelpPage FULL
  1699.          }
  1700.       }
  1701.    } -underline 0 -accelerator "Ctrl-G"
  1702. menu .mbar.options.menu -tearoff 0
  1703.    .mbar.options.menu add checkbutton -label "Autocommit Pages" \
  1704.       -variable gb_page_autocommit
  1705.  
  1706. # Create the menu
  1707. tk_menuBar .mbar .mbar.file .mbar.edit .mbar.format \
  1708.    .mbar.justify .mbar.page .mbar.navigate
  1709.  
  1710. ###############################################################
  1711. # Create the page label
  1712. set frame [frame .name_fr -relief groove -borderwidth $RIDGE_BORDER]
  1713. label $frame.label -text "Page Label"
  1714. entry $frame.name -width 25 -state disabled
  1715. button $frame.save -text Save -command {MH_SaveHelpPage}
  1716. $frame.save configure -state disabled -disabledforeground ""
  1717. button $frame.open -text "..." -command {
  1718.    if {$gb_current_page_changed == 0 || $gb_page_autocommit == 1} {
  1719.       MH_SaveHelpPage
  1720.       MH_SelectHelpPage FULL
  1721.    } else {
  1722.       if ![MH_QuestionDialog . "Help text on this page has changed!" \
  1723.          "Discard Changes" "Cancel"] {
  1724.          MH_SelectHelpPage FULL
  1725.       }
  1726.    }
  1727. }
  1728. pack $frame.label $frame.name $frame.open $frame.save -side left \
  1729.    -fill x -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING
  1730. pack $frame -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING -fill x
  1731.  
  1732. ###############################################################
  1733. # Create the text widget
  1734. frame .fr -borderwidth $RIDGE_BORDER -relief groove
  1735. pack .fr -padx $DEFAULT_PADDING -pady $DEFAULT_PADDING -side top \
  1736.    -expand true -fill both
  1737. set gt_mini_help [MH_ScrolledText .fr.help 70 20 0]
  1738. $gt_mini_help configure -font $FONT_NORMAL -bg $TEXT_COLOUR -state \
  1739.    disabled
  1740. $gt_mini_help tag bind sel <3> {+MH_PopupMenu $gt_mini_help .mbar.format.menu}
  1741. $gt_mini_help tag bind sel <Control-3> {+MH_PopupMenu $gt_mini_help .mbar.edit.menu}
  1742. $gt_mini_help tag bind sel <Shift-3> {+MH_PopupMenu $gt_mini_help .mbar.justify.menu}
  1743. bind $gt_mini_help <KeyPress> {
  1744.    set gb_current_page_changed 1
  1745.    set gb_project_changed      1
  1746.    $frame.save configure -state normal
  1747. }
  1748. pack .fr.help -side top -anchor w
  1749.  
  1750. # Pop-up the open dialogue
  1751. MH_OpenProject
  1752.